It had been over two years since I last looked at them, but I returned to Haskell, GUI and GTK4 on Windows. This time, things were more straightforward. To set things up again, I added the following MSYS2 packages to the Stack-supplied MSYS2 with stack exec -- pacman -S:

mingw-w64-x86_64-pkgconfig 
mingw-w64-x86_64-gobject-introspection 
mingw-w64-x86_64-gtksourceview5 
mingw-w64-x86_64-gtk4 
mingw-w64-x86_64-atk

mingw-w64-x86_64-pkgconfig

mingw-w64-x86_64-gobject-introspection

mingw-w64-x86_64-gtksourceview5

mingw-w64-x86_64-gtk4

mingw-w64-x86_64-atk

and set PKG_CONFIG_PATH to the mingw64\lib\pkgconfig directory and XDG_DATA_DIRS to the mingw64\share directory (of the Stack-supplied MSYS2).

MSYS2 package mingw-w64-x86_64-gtk4 does not have a dependancy on mingw-w64-x86_64-atk, but Haskell package gi-gtk >= 4.0 has a dependency on gi-atk. I asked a question about that at the haskell-gi GitHub repository.

A basic gktTest

I named the example package gtkTest, as before, with Main.hs as follows (being the haskell-gi repository’s current “Hello! World” program):

{-# LANGUAGE ImplicitParams      #-}
{-# LANGUAGE OverloadedLabels    #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings   #-}

module Main
  ( main
  ) where

import           Control.Monad ( void )
import           Data.GI.Base ( AttrOp (..), new, set )
import qualified GI.Gtk as Gtk

activate :: Gtk.Application -> IO ()
activate app = do
  button <- new Gtk.Button
    [ #label := "Click me"
    , On #clicked ( ?self `set` [ #sensitive := False
                                , #label := "Thanks for clicking me"
                                ]
                  )
    ]

  window <- new Gtk.ApplicationWindow
    [ #application := app
    , #title := "Hi there"
    , #child := button
    ]
  window.show

main :: IO ()
main = do
  app <- new Gtk.Application
    [ #applicationId := "haskell-gi.example"
    , On #activate (activate ?self)
    ]

  void $ app.run Nothing

{-# LANGUAGE ImplicitParams #-}

{-# LANGUAGE OverloadedLabels #-}

{-# LANGUAGE OverloadedRecordDot #-}

{-# LANGUAGE OverloadedStrings #-}

module Main

( main

) where

import Control.Monad ( void )

import Data.GI.Base ( AttrOp (..), new, set )

import qualified GI.Gtk as Gtk

activate :: Gtk.Application -> IO ()

activate app = do

button <- new Gtk.Button

[ #label := "Click me"

, On #clicked ( ?self `set` [ #sensitive := False

, #label := "Thanks for clicking me"

]

)

]

window <- new Gtk.ApplicationWindow

[ #application := app

, #title := "Hi there"

, #child := button

]

window.show

main :: IO ()

main = do

app <- new Gtk.Application

[ #applicationId := "haskell-gi.example"

, On #activate (activate ?self)

]

void $ app.run Nothing

with a package.yaml specifying dependencies:

dependencies:
- base >= 4.7 && < 5
- gi-gtk >= 4.0
- haskell-gi-base

dependencies:

- base >= 4.7 && < 5

- gi-gtk >= 4.0

- haskell-gi-base

and with Stack project-level configuration:

snapshot: lts-22.39 # GHC 9.6.6

extra-deps:
- gi-gtk-4.0.9
- gi-gdk-4.0.9
- gi-gsk-4.0.8

snapshot: lts-22.39 # GHC 9.6.6

extra-deps:

- gi-gtk-4.0.9

- gi-gdk-4.0.9

- gi-gsk-4.0.8

I sought to understand how this program worked and, in particular, the use of ?self and app.run.

new

new is used in connection with app, window and button. Module Data.GI.Base.Constructible provides a type class Constructible with a default instance:

class Constructible obj (tag :: AttrOpTag) where
  new :: MonadIO m => (ManagedPtr obj -> obj) -> [AttrOp obj tag] -> m obj

instance {-# OVERLAPPABLE #-}
  (GObject obj, tag ~ 'AttrConstruct) => Constructible obj tag where
    new = constructGObject

class Constructible obj (tag :: AttrOpTag) where

new :: MonadIO m => (ManagedPtr obj -> obj) -> [AttrOp obj tag] -> m obj

instance {-# OVERLAPPABLE #-}

(GObject obj, tag ~ 'AttrConstruct) => Constructible obj tag where

new = constructGObject

In the code extract above, and other extracts, I have renamed type variables for consistency between extracts.

GI.Gtk.Objects.Application.Application is an instance of GObject.

Data.GI.Base.GObject.constructGObject makes use of Data.GI.Base.Signals.on:

on :: 
     forall obj info m. (GObject obj, MonadIO m, SignalInfo info) 
  => obj 
  -> SignalProxy obj info
  -> ((?self :: obj) => HaskellCallbackType info)
  -> m SignalHandlerId
on o p c =
  liftIO $ connectSignal @info o w SignalConnectBefore (proxyDetail p)
 where 
  w :: obj -> HaskellCallbackType info
  w parent = let ?self = parent in c

on ::

forall obj info m. (GObject obj, MonadIO m, SignalInfo info)

=> obj

-> SignalProxy obj info

-> ((?self :: obj) => HaskellCallbackType info)

-> m SignalHandlerId

on o p c =

liftIO $ connectSignal @info o w SignalConnectBefore (proxyDetail p)

where

w :: obj -> HaskellCallbackType info

w parent = let ?self = parent in c

and on binds the implicit parameter ?self.

Given the language extension ImplicitParams, the implicit parameter ?self can be passed to activate.

AttrOp

Data.GI.Base.Attributes.AttrOp is a type with a number of data constructors, including (:=) (assign a value to an attribute) and On (connect the given signal to a signal handler.).

On :: 
     forall obj info (tag :: AttrOpTag). (GObject obj, SignalInfo info) 
  => SignalProxy obj info 
  -> ((?self :: obj) => HaskellCallbackType info) 
  -> AttrOp obj tag

On ::

forall obj info (tag :: AttrOpTag). (GObject obj, SignalInfo info)

=> SignalProxy obj info

-> ((?self :: obj) => HaskellCallbackType info)

-> AttrOp obj tag

app.run Nothing

In the example, app.run means the same as #run app.

Given the language extension OverloadedRecordDot, app.run is equivalent to getField @"run" app.

Module GHC.Record provides type class HasField which promises getField:

class HasField t obj p | t obj -> p where
  getField :: obj -> p

1 2	class HasField t obj p \| t obj -> p where getField :: obj -> p

Given the language extension VisibleTypeApplications, @"run" in getField @"run" app specifies the type t in type class HasField t obj p. Given the language extentions DataKinds, "run" is a type-level literal of kind String. As app is of type Application, that specifies type obj in type class HasField t obj p.

Module GI.Gtk.Objects.Application provides an instance of HasField

import qualified Data.GI.Base.Overloading as O
import qualified GHC.Records as R
...
#if MIN_VERSION_base(4,13,0)
instance ( info ~ ResolveApplicationMethod t Application
         , O.OverloadedMethod info Application p
         , R.HasField t Application p
         ) => R.HasField t Application p where
  getField = O.overloadedMethod @info
#endif

import qualified Data.GI.Base.Overloading as O

import qualified GHC.Records as R

...

#if MIN_VERSION_base(4,13,0)

instance ( info ~ ResolveApplicationMethod t Application

, O.OverloadedMethod info Application p

, R.HasField t Application p

) => R.HasField t Application p where

getField = O.overloadedMethod @info

#endif

Including the instance head (HasField t Application p) as a constraint in the instance context is a ‘trick’ which permits polymorphic fields.

Data.GI.Base.Overloading.overloadedMethod is promised by type class OverloadedMethod:

class OverloadedMethod info obj signature where
  overloadedMethod :: obj -> signature

1 2	class OverloadedMethod info obj signature where overloadedMethod :: obj -> signature

Given the language extension VisualTypeApplications, the @info in O.overloadedMethod @info specifies the type info in type class OverloadedMethod info obj s. info is constrained to be equivalent to ResolveApplicationMethod t Application. When t is the type literal "run", that is equal to ApplicationRunMethodInfo (see further below).

Module GI.Gio.Objects.Application provides an instance of OverloadedMethod:

instance ( signature ~ (Maybe ([[Char]]) -> m Int32)
         , MonadIO m
         , IsApplication obj
         ) => O.OverloadedMethod ApplicationRunMethodInfo obj signature where
  overloadedMethod = applicationRun

instance ( signature ~ (Maybe ([[Char]]) -> m Int32)

, MonadIO m

, IsApplication obj

) => O.OverloadedMethod ApplicationRunMethodInfo obj signature where

overloadedMethod = applicationRun

applicationRun ::
     (B.CallStack.HasCallStack, MonadIO m, IsApplication obj)
  => obj
  -> Maybe ([[Char]]) 
  -> m Int32

applicationRun ::

(B.CallStack.HasCallStack, MonadIO m, IsApplication obj)

=> obj

-> Maybe ([[Char]])

-> m Int32

and module GI.Gtk.Objects.Application provides a type family:

import qualified Data.Kind as DK
import qualified GI.Gio.Objects.Application as Gio.Application
...
type family ResolveApplicationMethod (t :: Symbol) (obj :: DK.Type) :: DK.Type where
  ...
  ResolveApplicationMethod "run" obj = Gio.Application.ApplicationRunMethodInfo

import qualified Data.Kind as DK

import qualified GI.Gio.Objects.Application as Gio.Application

...

type family ResolveApplicationMethod (t :: Symbol) (obj :: DK.Type) :: DK.Type where

...

ResolveApplicationMethod "run" obj = Gio.Application.ApplicationRunMethodInfo

A less basic gtkTest

I tried a less basic version of gtkTest, using a Grid of three Button values, with Main.hs:

{-# LANGUAGE ImplicitParams      #-}
{-# LANGUAGE OverloadedLabels    #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings   #-}

module Main
  ( main
  ) where

import           Control.Monad ( void )
import           Data.GI.Base ( AttrOp (..), new, set )
import           Data.Text ( Text )
import qualified GI.Gtk as Gtk

activate :: Gtk.Application -> IO ()
activate app = do

  grid <- new Gtk.Grid []

  button1 <- mkButton "Click me!"
  button2 <- mkButton "No, click me!"
  button3 <- mkButton "Better click me!"

  #attach grid button1 0 0 1 1
  #attach grid button2 1 0 1 1
  #attach grid button3 0 1 2 1

  window <- new Gtk.ApplicationWindow
    [ #application := app
    , #title := "Hi there"
    , #child := grid
    ]
  window.show

mkButton :: Text -> IO Gtk.Button
mkButton label = new Gtk.Button
  [ #label := label
  , On #clicked ( ?self `set` [ #sensitive := False
                              , #label := "Thanks for clicking me"
                              ]
                )
  , #hexpand := True
  ]

main :: IO ()
main = do
  app <- new Gtk.Application
    [ #applicationId := "haskell-gi.example"
    , On #activate (activate ?self)
    ]

  void $ app.run Nothing

{-# LANGUAGE ImplicitParams #-}

{-# LANGUAGE OverloadedLabels #-}

{-# LANGUAGE OverloadedRecordDot #-}

{-# LANGUAGE OverloadedStrings #-}

module Main

( main

) where

import Control.Monad ( void )

import Data.GI.Base ( AttrOp (..), new, set )

import Data.Text ( Text )

import qualified GI.Gtk as Gtk

activate :: Gtk.Application -> IO ()

activate app = do

grid <- new Gtk.Grid []

button1 <- mkButton "Click me!"

button2 <- mkButton "No, click me!"

button3 <- mkButton "Better click me!"

#attach grid button1 0 0 1 1

#attach grid button2 1 0 1 1

#attach grid button3 0 1 2 1

window <- new Gtk.ApplicationWindow

[ #application := app

, #title := "Hi there"

, #child := grid

]

window.show

mkButton :: Text -> IO Gtk.Button

mkButton label = new Gtk.Button

[ #label := label

, On #clicked ( ?self `set` [ #sensitive := False

, #label := "Thanks for clicking me"

]

)

, #hexpand := True

]

main :: IO ()

main = do

app <- new Gtk.Application

[ #applicationId := "haskell-gi.example"

, On #activate (activate ?self)

]

void $ app.run Nothing

The result was as below, but I had to specify #hexpand := True for the buttons to take advantage of the available horizontal space. That is because an ApplicationWindow is a single-child container while a Grid is a multi-child container; the default behaviour is different.

A gtkTest with input and output

I tried a further variation with input (two Entry values) and output (a Label value):

{-# LANGUAGE ImplicitParams      #-}
{-# LANGUAGE OverloadedLabels    #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings   #-}

module Main
  ( main
  ) where

import           Control.Monad ( void )
import           Data.GI.Base ( AttrOp (..), get, new, on, set )
import           Data.Text ( Text )
import qualified Data.Text as T
import qualified Data.Text.Read as T
import qualified GI.Gtk as Gtk

activate :: Gtk.Application -> IO ()
activate app = do

  grid <- new Gtk.Grid
    [ #columnSpacing := 5
    , #rowSpacing := 5
    , #marginBottom := 5
    , #marginEnd := 5
    , #marginStart := 5
    , #marginTop := 5
    ]

  labelHeight <- mkLabel "Height:"
  labelRadius <- mkLabel "Radius:"
  labelResult <- mkLabel "Volume:"
  labelValue <- mkLabel "None"

  entryHeight <- mkEntry
  entryRadius <- mkEntry

  let update = do
        hText <- entryHeight `get` #text
        rText <- entryRadius `get` #text
        case (T.rational hText, T.rational rText) of
          (Right (h, _), Right (r, _)) ->
            labelValue `set` [ #label := T.show $ cone h r ]
          (_, _) -> labelValue `set`
            [ #label := "One or both of height and radius is invalid."]

  void $ on entryHeight #changed update
  void $ on entryRadius #changed update

  #attach grid labelHeight 0 0 1 1
  #attach grid labelRadius 0 1 1 1
  #attach grid labelResult 0 2 1 1
  #attach grid labelValue 1 2 1 1
  #attach grid entryHeight 1 0 1 1
  #attach grid entryRadius 1 1 1 1

  window <- new Gtk.ApplicationWindow
    [ #application := app
    , #title := "Volume of a cone"
    , #child := grid
    ]
  window.show

mkLabel :: Text -> IO Gtk.Label
mkLabel label = new Gtk.Label
  [ #label := label
  , #halign := Gtk.AlignStart
  ]

mkEntry :: IO Gtk.Entry
mkEntry = new Gtk.Entry [ #halign := Gtk.AlignStart ]

main :: IO ()
main = do
  app <- new Gtk.Application
    [ #applicationId := "haskell-gi.example"
    , On #activate (activate ?self)
    ]

  void $ app.run Nothing

cone :: Double -> Double -> Double
cone h r = h * pi * r * r / 3.0

{-# LANGUAGE ImplicitParams #-}

{-# LANGUAGE OverloadedLabels #-}

{-# LANGUAGE OverloadedRecordDot #-}

{-# LANGUAGE OverloadedStrings #-}

module Main

( main

) where

import Control.Monad ( void )

import Data.GI.Base ( AttrOp (..), get, new, on, set )

import Data.Text ( Text )

import qualified Data.Text as T

import qualified Data.Text.Read as T

import qualified GI.Gtk as Gtk

activate :: Gtk.Application -> IO ()

activate app = do

grid <- new Gtk.Grid

[ #columnSpacing := 5

, #rowSpacing := 5

, #marginBottom := 5

, #marginEnd := 5

, #marginStart := 5

, #marginTop := 5

]

labelHeight <- mkLabel "Height:"

labelRadius <- mkLabel "Radius:"

labelResult <- mkLabel "Volume:"

labelValue <- mkLabel "None"

entryHeight <- mkEntry

entryRadius <- mkEntry

let update = do

hText <- entryHeight `get` #text

rText <- entryRadius `get` #text

case (T.rational hText, T.rational rText) of

(Right (h, _), Right (r, _)) ->

labelValue `set` [ #label := T.show $ cone h r ]

(_, _) -> labelValue `set`

[ #label := "One or both of height and radius is invalid."]

void $ on entryHeight #changed update

void $ on entryRadius #changed update

#attach grid labelHeight 0 0 1 1

#attach grid labelRadius 0 1 1 1

#attach grid labelResult 0 2 1 1

#attach grid labelValue 1 2 1 1

#attach grid entryHeight 1 0 1 1

#attach grid entryRadius 1 1 1 1

window <- new Gtk.ApplicationWindow

[ #application := app

, #title := "Volume of a cone"

, #child := grid

]

window.show

mkLabel :: Text -> IO Gtk.Label

mkLabel label = new Gtk.Label

[ #label := label

, #halign := Gtk.AlignStart

]

mkEntry :: IO Gtk.Entry

mkEntry = new Gtk.Entry [ #halign := Gtk.AlignStart ]

main :: IO ()

main = do

app <- new Gtk.Application

[ #applicationId := "haskell-gi.example"

, On #activate (activate ?self)

]

void $ app.run Nothing

cone :: Double -> Double -> Double

cone h r = h * pi * r * r / 3.0

The use of Data.Text.show requires Haskell package text >= 2.1.2.

The default value of halign is AlignFill, which centres when there is no meaningful way to stretch.

The result was as below:

Haskell and GUI revisited

A basic gktTest

new

AttrOp

app.run Nothing

A less basic gtkTest

A gtkTest with input and output

static-bytes and endianess